home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 8 / Eagles_Nest_Mac_Collection_Disc_8.TOAST / Developer Tools⁄Additions / MacScheme20 / Native Folder / native.sch next >
Encoding:
Text File  |  1989-01-13  |  1.6 KB  |  46 lines  |  [TEXT/EDIT]

  1. ; Takes a string of hex characters representing mixed byte code
  2. ; and Motorola 68000 machine code,
  3. ; and an arbitrary number of constants referred to
  4. ; by the code, and encapsulates the code in a Scheme procedure,
  5. ; which it returns.
  6. ;
  7. ; The string should probably look like:
  8. ;
  9. ;       95n8            args=   n8            ;byte code
  10. ;       6300            native2               ;byte code
  11. ;                       <native code>
  12. ;       49FA0004        LEA     *+4,A4
  13. ;       4ED6            JMP     (A6)
  14. ;       98              restore               ;byte code
  15.  
  16. (define hex2
  17.     (lambda (c1 c2)
  18.       (+ (* 16 (hex->int c1)) (hex->int c2))))
  19.  
  20. (define hex->int 
  21.     (lambda (c)
  22.       (cond ((and (char>=? c #\0) (char<=? c #\9))
  23.              (- (char->integer c) (char->integer #\0)))
  24.             ((and (char>=? c #\a) (char<=? c #\f))
  25.              (+ (- (char->integer c) (char->integer #\a)) 10))
  26.             ((and (char>=? c #\A) (char<=? c #\F))
  27.              (+ (- (char->integer c) (char->integer #\A)) 10))
  28.             (else ?))))
  29.   
  30.  
  31. (define wrap-code
  32.    (lambda (code . constants)
  33.       (do ((code (->bytevector code))
  34.            (bcode (make-bytevector (quotient (string-length code) 2)))
  35.            (i 0 (+ i 1))
  36.            (j 0 (+ j 2))
  37.            (n (quotient (string-length code) 2)))
  38.           ((=? i n)
  39.            (->procedure
  40.             (list (cons bcode (list->vector (cons '() constants))))))
  41.           (bytevector-set! bcode
  42.                            i
  43.                            (hex2 (bytevector-ref code j)
  44.                                  (bytevector-ref code (1+ j)))))))
  45.  
  46.